home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / GNU-TILE-FORTH.lha / tst / discrimination-net.tst < prev    next >
Text File  |  1992-05-19  |  3KB  |  162 lines
  1. .( Loading Discrimination Net test...) cr
  2.  
  3. #include relations.f83
  4. #include blocks.f83
  5.  
  6. string blocks relations forth definitions
  7.  
  8. \ Discrimination tree interpreter
  9.  
  10. item question
  11.  
  12. : ?question ( node -- node addr)
  13.   question over ?get-relation not if 2drop nil then
  14. ;
  15.  
  16. : .question ( question -- )
  17.   $print space
  18. ;
  19.  
  20. : .relations ( node -- )
  21.   ." One of the following:" cr
  22.   block[ ( value relation -- )
  23.     dup question = if drop else .item space then drop
  24.   ]; map-item
  25. ;
  26.  
  27. : ?scan-relation ( node1 -- [node2 true] or [node1 false])
  28.   32 word find 
  29.   if >body swap ?get-relation dup not
  30.     if drop nip false then
  31.   else
  32.     drop false
  33.   then
  34. ;
  35.  
  36. : discriminate ( node -- item)
  37.   begin
  38.     ?question ?dup
  39.   while
  40.     .question ?scan-relation not
  41.     if dup .relations cr then
  42.   repeat
  43. ;
  44.  
  45.  
  46. \ A Garden-variety discrimination tree
  47. \ From E. Charniak, et al., Aritificial Intelligence Programming,
  48. \ Chap. 8 Simple Discrimination Nets, pp. 153.
  49.  
  50. item node#1
  51. item node#2
  52. item node#3
  53. item node#4
  54. item node#5
  55.  
  56. item red
  57. item green
  58. item yellow
  59.  
  60. item round
  61. item cylindrical
  62. item flat
  63.  
  64. item small
  65. item medium
  66. item large
  67.  
  68. item TOMATO
  69. item PEAS
  70. item BRUSSEL-SPROUTS
  71. item GREEN-BEANS
  72. item ASPARAGUS
  73. item SPINACH
  74. item WAX-BEANS
  75. item YELLOW-SQUASH
  76.  
  77. \ Build the Garden-variety discrimination tree
  78.  
  79. " What color is it?" question node#1 put-relation
  80. TOMATO red node#1 put-relation
  81. node#2 green node#1 put-relation
  82. node#3 yellow node#1 put-relation
  83.  
  84. " What shape is it?" question node#2 put-relation
  85. node#4 round node#2 put-relation
  86. node#5 cylindrical node#2 put-relation
  87. SPINACH flat node#2 put-relation
  88.  
  89. " What size is it?" question node#3 put-relation
  90. WAX-BEANS medium node#3 put-relation
  91. YELLOW-SQUASH large node#3 put-relation
  92.  
  93. " What size is it?" question node#4 put-relation
  94. PEAS small node#4 put-relation
  95. BRUSSEL-SPROUTS medium node#4 put-relation
  96.  
  97. " What size is it?" question node#5 put-relation
  98. GREEN-BEANS small node#5 put-relation
  99. ASPARAGUS large node#5 put-relation
  100.  
  101. \ The Garden-variety help 
  102.  
  103. : plant-help ( -- )
  104.   node#1 discriminate ." The plant is a " .item cr
  105. ;
  106.  
  107.  
  108. \ Discrimination net from BABEL 
  109.  
  110. item node#1
  111. item node#2
  112. item node#3
  113. item node#4
  114. item node#5
  115. item node#6
  116. item node#7
  117.  
  118. item yes
  119. item no
  120.  
  121. item INGEST
  122. item EAT
  123. item DRINK
  124. item INHALE
  125. item BREATHE
  126. item TAKE
  127. item SMOKE
  128.  
  129. " Is the thing ingested a medicine?" question node#1 put-relation
  130. node#2 no node#1 put-relation
  131. TAKE yes node#1 put-relation
  132.  
  133. " Is it a gas?" question node#2 put-relation
  134. node#3 no node#2 put-relation
  135. node#4 yes node#2 put-relation
  136.  
  137. " Is it a fluid?" question node#3 put-relation
  138. node#5 no node#3 put-relation
  139. node#6 yes node#3 put-relation
  140.  
  141. " Is it something used for smoking?" question node#4 put-relation
  142. node#7 no node#4 put-relation
  143. SMOKE yes node#4 put-relation
  144.  
  145. " Is it ingested via the mouth?" question node#5 put-relation
  146. INGEST no node#5 put-relation
  147. EAT yes node#5 put-relation
  148.  
  149. " Is it alcohol?" question node#6 put-relation
  150. DRINK no node#6 put-relation
  151. DRINK yes node#6 put-relation
  152.  
  153. " Is it air?" question node#7 put-relation
  154. INHALE no node#7 put-relation
  155. BREATHE yes node#7 put-relation
  156.  
  157. : babel ( -- )
  158.   node#1 discriminate ." Use the word " .item cr
  159. ;
  160.  
  161. forth only
  162.